home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Doc / classes.int < prev    next >
Encoding:
Text File  |  2001-05-22  |  48.0 KB  |  1,313 lines
  1. { *************************************************************************** }
  2. {                                                                             }
  3. { Delphi and Kylix Cross-Platform Visual Component Library                    }
  4. {                                                                             }
  5. { Copyright (c) 1995, 2001 Borland Software Corporation                       }
  6. {                                                                             }
  7. { *************************************************************************** }
  8.  
  9.  
  10. unit Classes;
  11.  
  12. {$R-,T-,X+,H+,B-}
  13.  
  14. {$IFDEF MSWINDOWS}
  15. { ACTIVEX.HPP is not required by CLASSES.HPP }
  16. (*$NOINCLUDE ActiveX*)
  17. {$ENDIF}
  18. {$IFDEF LINUX}
  19. {$DEFINE _WIN32}
  20. {$ENDIF}
  21. {$IFDEF MSWINDOWS}
  22. {$DEFINE _WIN32}
  23. {$ENDIF}
  24.  
  25.  
  26. interface
  27.  
  28. {$IFDEF MSWINDOWS}
  29. uses Windows, Messages, SysUtils, Variants, TypInfo, ActiveX;
  30. {$ENDIF}
  31. {$IFDEF LINUX}
  32. uses Libc, SysUtils, Variants, TypInfo, Types;
  33. {$ENDIF}
  34.  
  35. const
  36.  
  37. { Maximum TList size }
  38.  
  39.   MaxListSize = Maxint div 16;
  40.  
  41. { TStream seek origins }
  42.  
  43.   soFromBeginning = 0;
  44.   soFromCurrent = 1;
  45.   soFromEnd = 2;
  46.  
  47. type
  48. { TStream seek origins }
  49.   TSeekOrigin = (soBeginning, soCurrent, soEnd);
  50.  
  51. const
  52. { TFileStream create mode }
  53.  
  54.   fmCreate = $FFFF;
  55.  
  56. { TParser special tokens }
  57.  
  58.   toEOF     = Char(0);
  59.   toSymbol  = Char(1);
  60.   toString  = Char(2);
  61.   toInteger = Char(3);
  62.   toFloat   = Char(4);
  63.   toWString = Char(5);
  64.  
  65.   {!! Moved here from menus.pas !!}
  66.   { TShortCut special values }
  67.  
  68.   scShift = $2000;
  69.   scCtrl = $4000;
  70.   scAlt = $8000;
  71.   scNone = 0;
  72.  
  73. type
  74.  
  75. { Text alignment types }
  76.  
  77.   TAlignment = (taLeftJustify, taRightJustify, taCenter);
  78.   TLeftRight = taLeftJustify..taRightJustify;
  79.   TBiDiMode = (bdLeftToRight, bdRightToLeft, bdRightToLeftNoAlign,
  80.     bdRightToLeftReadingOnly);
  81.  
  82. { Types used by standard events }
  83.  
  84.   TShiftState = set of (ssShift, ssAlt, ssCtrl,
  85.     ssLeft, ssRight, ssMiddle, ssDouble);
  86.  
  87.   THelpContext = -MaxLongint..MaxLongint;
  88.   THelpType = (htKeyword, htContext);
  89.  
  90.   {!! Moved here from menus.pas !!}
  91.   TShortCut = Low(Word)..High(Word);
  92.  
  93. { Standard events }
  94.  
  95.   TNotifyEvent = procedure(Sender: TObject) of object;
  96.   TGetStrProc = procedure(const S: string) of object;
  97.  
  98. { Exception classes }
  99.  
  100.   EStreamError = class(Exception);
  101.   EFCreateError = class(EStreamError);
  102.   EFOpenError = class(EStreamError);
  103.   EFilerError = class(EStreamError);
  104.   EReadError = class(EFilerError);
  105.   EWriteError = class(EFilerError);
  106.   EClassNotFound = class(EFilerError);
  107.   EMethodNotFound = class(EFilerError);
  108.   EInvalidImage = class(EFilerError);
  109.   EResNotFound = class(Exception);
  110.   EListError = class(Exception);
  111.   EBitsError = class(Exception);
  112.   EStringListError = class(Exception);
  113.   EComponentError = class(Exception);
  114.   EParserError = class(Exception);
  115.   EOutOfResources = class(EOutOfMemory);
  116.   EInvalidOperation = class(Exception);
  117.  
  118. { Duplicate management }
  119.  
  120.   TDuplicates = (dupIgnore, dupAccept, dupError);
  121.  
  122. { Forward class declarations }
  123.  
  124.   TStream = class;
  125.   TFiler = class;
  126.   TReader = class;
  127.   TWriter = class;
  128.   TComponent = class;
  129.  
  130. { TList class }
  131.  
  132.   PPointerList = ^TPointerList;
  133.   TPointerList = array[0..MaxListSize - 1] of Pointer;
  134.   TListSortCompare = function (Item1, Item2: Pointer): Integer;
  135.   TListNotification = (lnAdded, lnExtracted, lnDeleted);
  136.  
  137.   // these operators are used in Assign and go beyond simply copying
  138.   //   laCopy = dest becomes a copy of the source
  139.   //   laAnd  = intersection of the two lists
  140.   //   laOr   = union of the two lists
  141.   //   laXor  = only those not in both lists
  142.   // the last two operators can actually be thought of as binary operators but
  143.   // their implementation has been optimized over their binary equivalent.
  144.   //   laSrcUnique  = only those unique to source (same as laAnd followed by laXor)
  145.   //   laDestUnique = only those unique to dest   (same as laOr followed by laXor)
  146.   TListAssignOp = (laCopy, laAnd, laOr, laXor, laSrcUnique, laDestUnique);
  147.  
  148.   TList = class(TObject)
  149.   protected
  150.     function Get(Index: Integer): Pointer;
  151.     procedure Grow; virtual;
  152.     procedure Put(Index: Integer; Item: Pointer);
  153.     procedure Notify(Ptr: Pointer; Action: TListNotification); virtual;
  154.     procedure SetCapacity(NewCapacity: Integer);
  155.     procedure SetCount(NewCount: Integer);
  156.   public
  157.     destructor Destroy; override;
  158.     function Add(Item: Pointer): Integer;
  159.     procedure Clear; virtual;
  160.     procedure Delete(Index: Integer);
  161.     class procedure Error(const Msg: string; Data: Integer); overload; virtual;
  162.     class procedure Error(Msg: PResStringRec; Data: Integer); overload;
  163.     procedure Exchange(Index1, Index2: Integer);
  164.     function Expand: TList;
  165.     function Extract(Item: Pointer): Pointer;
  166.     function First: Pointer;
  167.     function IndexOf(Item: Pointer): Integer;
  168.     procedure Insert(Index: Integer; Item: Pointer);
  169.     function Last: Pointer;
  170.     procedure Move(CurIndex, NewIndex: Integer);
  171.     function Remove(Item: Pointer): Integer;
  172.     procedure Pack;
  173.     procedure Sort(Compare: TListSortCompare);
  174.     procedure Assign(ListA: TList; AOperator: TListAssignOp = laCopy; ListB: TList = nil);
  175.     property Capacity: Integer;
  176.     property Count: Integer;
  177.     property Items[Index: Integer]: Pointer; default;
  178.     property List: PPointerList;
  179.   end;
  180.  
  181. { TThreadList class }
  182.  
  183.   TThreadList = class
  184.   public
  185.     constructor Create;
  186.     destructor Destroy; override;
  187.     procedure Add(Item: Pointer);
  188.     procedure Clear;
  189.     function  LockList: TList;
  190.     procedure Remove(Item: Pointer);
  191.     procedure UnlockList;
  192.     property Duplicates: TDuplicates;
  193.   end;
  194.  
  195. { IInterfaceList interface }
  196.  
  197.   IInterfaceList = interface
  198.   ['{285DEA8A-B865-11D1-AAA7-00C04FB17A72}']
  199.     function Get(Index: Integer): IInterface;
  200.     function GetCapacity: Integer;
  201.     function GetCount: Integer;
  202.     procedure Put(Index: Integer; const Item: IInterface);
  203.     procedure SetCapacity(NewCapacity: Integer);
  204.     procedure SetCount(NewCount: Integer);
  205.  
  206.     procedure Clear;
  207.     procedure Delete(Index: Integer);
  208.     procedure Exchange(Index1, Index2: Integer);
  209.     function First: IInterface;
  210.     function IndexOf(const Item: IInterface): Integer;
  211.     function Add(const Item: IInterface): Integer;
  212.     procedure Insert(Index: Integer; const Item: IInterface);
  213.     function Last: IInterface;
  214.     function Remove(const Item: IInterface): Integer;
  215.     procedure Lock;
  216.     procedure Unlock;
  217.     property Capacity: Integer;
  218.     property Count: Integer;
  219.     property Items[Index: Integer]: IInterface; default;
  220.   end;
  221.  
  222. { EXTERNALSYM IInterfaceList}
  223.  
  224. { TInterfaceList class }
  225.  
  226.   TInterfaceList = class(TInterfacedObject, IInterfaceList)
  227.   protected
  228.     { IInterfaceList }
  229.     function Get(Index: Integer): IInterface;
  230.     function GetCapacity: Integer;
  231.     function GetCount: Integer;
  232.     procedure Put(Index: Integer; const Item: IInterface);
  233.     procedure SetCapacity(NewCapacity: Integer);
  234.     procedure SetCount(NewCount: Integer);
  235.   public
  236.     constructor Create;
  237.     destructor Destroy; override;
  238.     procedure Clear;
  239.     procedure Delete(Index: Integer);
  240.     procedure Exchange(Index1, Index2: Integer);
  241.     function Expand: TInterfaceList;
  242.     function First: IInterface;
  243.     function IndexOf(const Item: IInterface): Integer;
  244.     function Add(const Item: IInterface): Integer;
  245.     procedure Insert(Index: Integer; const Item: IInterface);
  246.     function Last: IInterface;
  247.     function Remove(const Item: IInterface): Integer;
  248.     procedure Lock;
  249.     procedure Unlock;
  250.     property Capacity: Integer;
  251.     property Count: Integer;
  252.     property Items[Index: Integer]: IInterface; default;
  253.   end;
  254.  
  255. { EXTERNALSYM TInterfaceList}
  256.  
  257. { TBits class }
  258.  
  259.   TBits = class
  260.   public
  261.     destructor Destroy; override;
  262.     function OpenBit: Integer;
  263.     property Bits[Index: Integer]: Boolean; default;
  264.     property Size: Integer;
  265.   end;
  266.  
  267. { TPersistent abstract class }
  268.  
  269. {$M+}
  270.  
  271.   TPersistent = class(TObject)
  272.   protected
  273.     procedure AssignTo(Dest: TPersistent); virtual;
  274.     procedure DefineProperties(Filer: TFiler); virtual;
  275.     function  GetOwner: TPersistent; dynamic;
  276.   public
  277.     destructor Destroy; override;
  278.     procedure Assign(Source: TPersistent); virtual;
  279.     function  GetNamePath: string; dynamic;
  280.   end;
  281.  
  282. {$M-}
  283.  
  284. { TPersistent class reference type }
  285.  
  286.   TPersistentClass = class of TPersistent;
  287.  
  288. { TInterfaced Persistent }
  289.  
  290.   TInterfacedPersistent = class(TPersistent, IInterface)
  291.   protected
  292.     { IInterface }
  293.     function _AddRef: Integer; stdcall;
  294.     function _Release: Integer; stdcall;
  295.   public
  296.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  297.     procedure AfterConstruction; override;
  298.   end;
  299.  
  300. { TRecall class }
  301.  
  302.   TRecall = class(TObject)
  303.   public
  304.     constructor Create(AStorage, AReference: TPersistent);
  305.     destructor Destroy; override;
  306.     procedure Store;
  307.     procedure Forget;
  308.     property Reference: TPersistent;
  309.   end;
  310.  
  311. { TCollection class }
  312.  
  313.   TCollection = class;
  314.  
  315.   TCollectionItem = class(TPersistent)
  316.   protected
  317.     procedure Changed(AllItems: Boolean);
  318.     function GetOwner: TPersistent; override;
  319.     function GetDisplayName: string; virtual;
  320.     procedure SetCollection(Value: TCollection); virtual;
  321.     procedure SetIndex(Value: Integer); virtual;
  322.     procedure SetDisplayName(const Value: string); virtual;
  323.   public
  324.     constructor Create(Collection: TCollection); virtual;
  325.     destructor Destroy; override;
  326.     function GetNamePath: string; override;
  327.     property Collection: TCollection;
  328.     property ID: Integer;
  329.     property Index: Integer;
  330.     property DisplayName: string;
  331.   end;
  332.  
  333.   TCollectionItemClass = class of TCollectionItem;
  334.   TCollectionNotification = (cnAdded, cnExtracting, cnDeleting);
  335.  
  336.   TCollection = class(TPersistent)
  337.   protected
  338.     procedure Added(var Item: TCollectionItem); virtual; deprecated;
  339.     procedure Deleting(Item: TCollectionItem); virtual; deprecated;
  340.     property NextID: Integer;
  341.     procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); virtual;
  342.     { Design-time editor support }
  343.     function GetAttrCount: Integer; dynamic;
  344.     function GetAttr(Index: Integer): string; dynamic;
  345.     function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
  346.     procedure Changed;
  347.     function GetItem(Index: Integer): TCollectionItem;
  348.     procedure SetItem(Index: Integer; Value: TCollectionItem);
  349.     procedure SetItemName(Item: TCollectionItem); virtual;
  350.     procedure Update(Item: TCollectionItem); virtual;
  351.     property PropName: string;
  352.     property UpdateCount: Integer;
  353.   public
  354.     constructor Create(ItemClass: TCollectionItemClass);
  355.     destructor Destroy; override;
  356.     function Owner: TPersistent;
  357.     function Add: TCollectionItem;
  358.     procedure Assign(Source: TPersistent); override;
  359.     procedure BeginUpdate; virtual;
  360.     procedure Clear;
  361.     procedure Delete(Index: Integer);
  362.     procedure EndUpdate; virtual;
  363.     function FindItemID(ID: Integer): TCollectionItem;
  364.     function GetNamePath: string; override;
  365.     function Insert(Index: Integer): TCollectionItem;
  366.     property Count: Integer;
  367.     property ItemClass: TCollectionItemClass;
  368.     property Items[Index: Integer]: TCollectionItem;
  369.   end;
  370.  
  371. { Collection class that maintains an "Owner" in order to obtain property
  372.   path information at design-time }
  373.  
  374.   TOwnedCollection = class(TCollection)
  375.   protected
  376.     function GetOwner: TPersistent; override;
  377.   public
  378.     constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
  379.   end;
  380.  
  381.   TStrings = class;
  382.  
  383. { TGetModuleProc }
  384. { Used in the TFormDesigner class to allow component/property editors access
  385.   to project specific information }
  386.  
  387.   TGetModuleProc = procedure(const FileName, UnitName, FormName,
  388.     DesignClass: string; CoClasses: TStrings) of object;
  389.  
  390. { IStringsAdapter interface }
  391. { Maintains link between TStrings and IStrings implementations }
  392.  
  393.   IStringsAdapter = interface
  394.     ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
  395.     procedure ReferenceStrings(S: TStrings);
  396.     procedure ReleaseStrings;
  397.   end;
  398.  
  399. { TStrings class }
  400.  
  401.   TStringsDefined = set of (sdDelimiter, sdQuoteChar);
  402.  
  403.   TStrings = class(TPersistent)
  404.   protected
  405.     procedure DefineProperties(Filer: TFiler); override;
  406.     procedure Error(const Msg: string; Data: Integer); overload;
  407.     procedure Error(Msg: PResStringRec; Data: Integer); overload;
  408.     function ExtractName(const S: string): string;
  409.     function Get(Index: Integer): string; virtual; abstract;
  410.     function GetCapacity: Integer; virtual;
  411.     function GetCount: Integer; virtual; abstract;
  412.     function GetObject(Index: Integer): TObject; virtual;
  413.     function GetTextStr: string; virtual;
  414.     procedure Put(Index: Integer; const S: string); virtual;
  415.     procedure PutObject(Index: Integer; AObject: TObject); virtual;
  416.     procedure SetCapacity(NewCapacity: Integer); virtual;
  417.     procedure SetTextStr(const Value: string); virtual;
  418.     procedure SetUpdateState(Updating: Boolean); virtual;
  419.     property UpdateCount: Integer;
  420.     function CompareStrings(const S1, S2: string): Integer; virtual;
  421.   public
  422.     destructor Destroy; override;
  423.     function Add(const S: string): Integer; virtual;
  424.     function AddObject(const S: string; AObject: TObject): Integer; virtual;
  425.     procedure Append(const S: string);
  426.     procedure AddStrings(Strings: TStrings); virtual;
  427.     procedure Assign(Source: TPersistent); override;
  428.     procedure BeginUpdate;
  429.     procedure Clear; virtual; abstract;
  430.     procedure Delete(Index: Integer); virtual; abstract;
  431.     procedure EndUpdate;
  432.     function Equals(Strings: TStrings): Boolean;
  433.     procedure Exchange(Index1, Index2: Integer); virtual;
  434.     function GetText: PChar; virtual;
  435.     function IndexOf(const S: string): Integer; virtual;
  436.     function IndexOfName(const Name: string): Integer; virtual;
  437.     function IndexOfObject(AObject: TObject): Integer; virtual;
  438.     procedure Insert(Index: Integer; const S: string); virtual; abstract;
  439.     procedure InsertObject(Index: Integer; const S: string;
  440.       AObject: TObject); virtual;
  441.     procedure LoadFromFile(const FileName: string); virtual;
  442.     procedure LoadFromStream(Stream: TStream); virtual;
  443.     procedure Move(CurIndex, NewIndex: Integer); virtual;
  444.     procedure SaveToFile(const FileName: string); virtual;
  445.     procedure SaveToStream(Stream: TStream); virtual;
  446.     procedure SetText(Text: PChar); virtual;
  447.     property Capacity: Integer;
  448.     property CommaText: string;
  449.     property Count: Integer;
  450.     property Delimiter: Char;
  451.     property DelimitedText: string;
  452.     property Names[Index: Integer]: string;
  453.     property Objects[Index: Integer]: TObject;
  454.     property QuoteChar: Char;
  455.     property Values[const Name: string]: string;
  456.     property Strings[Index: Integer]: string; default;
  457.     property Text: string;
  458.     property StringsAdapter: IStringsAdapter;
  459.   end;
  460.  
  461. { TStringList class }
  462.  
  463.   TStringList = class;
  464.  
  465.   PStringItem = ^TStringItem;
  466.   TStringItem = record
  467.     FString: string;
  468.     FObject: TObject;
  469.   end;
  470.  
  471.   PStringItemList = ^TStringItemList;
  472.   TStringItemList = array[0..MaxListSize] of TStringItem;
  473.   TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
  474.  
  475.   TStringList = class(TStrings)
  476.   protected
  477.     procedure Changed; virtual;
  478.     procedure Changing; virtual;
  479.     function Get(Index: Integer): string; override;
  480.     function GetCapacity: Integer; override;
  481.     function GetCount: Integer; override;
  482.     function GetObject(Index: Integer): TObject; override;
  483.     procedure Put(Index: Integer; const S: string); override;
  484.     procedure PutObject(Index: Integer; AObject: TObject); override;
  485.     procedure SetCapacity(NewCapacity: Integer); override;
  486.     procedure SetUpdateState(Updating: Boolean); override;
  487.     function CompareStrings(const S1, S2: string): Integer; override;
  488.     procedure InsertItem(Index: Integer; const S: string; AObject: TObject); virtual;
  489.   public
  490.     destructor Destroy; override;
  491.     function Add(const S: string): Integer; override;
  492.     function AddObject(const S: string; AObject: TObject): Integer; override;
  493.     procedure Clear; override;
  494.     procedure Delete(Index: Integer); override;
  495.     procedure Exchange(Index1, Index2: Integer); override;
  496.     function Find(const S: string; var Index: Integer): Boolean; virtual;
  497.     function IndexOf(const S: string): Integer; override;
  498.     procedure Insert(Index: Integer; const S: string); override;
  499.     procedure InsertObject(Index: Integer; const S: string;
  500.       AObject: TObject); override;
  501.     procedure Sort; virtual;
  502.     procedure CustomSort(Compare: TStringListSortCompare); virtual;
  503.     property Duplicates: TDuplicates;
  504.     property Sorted: Boolean;
  505.     property CaseSensitive: Boolean;
  506.     property OnChange: TNotifyEvent;
  507.     property OnChanging: TNotifyEvent;
  508.   end;
  509.  
  510. { TStream abstract class }
  511.  
  512.   TStream = class(TObject)
  513.   protected
  514.     procedure SetSize(NewSize: Longint); overload; virtual;
  515.     procedure SetSize(const NewSize: Int64); overload; virtual;
  516.   public
  517.     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
  518.     function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
  519.     function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;
  520.     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;
  521.     procedure ReadBuffer(var Buffer; Count: Longint);
  522.     procedure WriteBuffer(const Buffer; Count: Longint);
  523.     function CopyFrom(Source: TStream; Count: Int64): Int64;
  524.     function ReadComponent(Instance: TComponent): TComponent;
  525.     function ReadComponentRes(Instance: TComponent): TComponent;
  526.     procedure WriteComponent(Instance: TComponent);
  527.     procedure WriteComponentRes(const ResName: string; Instance: TComponent);
  528.     procedure WriteDescendent(Instance, Ancestor: TComponent); virtual;
  529.     procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
  530.     procedure WriteResourceHeader(const ResName: string; out FixupInfo: Integer);
  531.     procedure FixupResourceHeader(FixupInfo: Integer);
  532.     procedure ReadResHeader;
  533.     property Position: Int64;
  534.     property Size: Int64;
  535.   end;
  536.  
  537.   IStreamPersist = interface
  538.     ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}']
  539.     procedure LoadFromStream(Stream: TStream);
  540.     procedure SaveToStream(Stream: TStream);
  541.   end;
  542.  
  543. { THandleStream class }
  544.  
  545.   THandleStream = class(TStream)
  546.   protected
  547.     FHandle: Integer;
  548.     procedure SetSize(NewSize: Longint); override;
  549.     procedure SetSize(const NewSize: Int64); override;
  550.   public
  551.     constructor Create(AHandle: Integer);
  552.     function Read(var Buffer; Count: Longint): Longint; override;
  553.     function Write(const Buffer; Count: Longint): Longint; override;
  554.     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  555.     property Handle: Integer;
  556.   end;
  557.  
  558. { TFileStream class }
  559.  
  560.   TFileStream = class(THandleStream)
  561.   public
  562.     constructor Create(const FileName: string; Mode: Word); overload;
  563.     constructor Create(const FileName: string; Mode: Word; Rights: Cardinal); overload;
  564.     destructor Destroy; override;
  565.   end;
  566.  
  567. { TCustomMemoryStream abstract class }
  568.  
  569.   TCustomMemoryStream = class(TStream)
  570.   protected
  571.     procedure SetPointer(Ptr: Pointer; Size: Longint);
  572.   public
  573.     function Read(var Buffer; Count: Longint): Longint; override;
  574.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  575.     procedure SaveToStream(Stream: TStream);
  576.     procedure SaveToFile(const FileName: string);
  577.     property Memory: Pointer;
  578.   end;
  579.  
  580. { TMemoryStream }
  581.  
  582.   TMemoryStream = class(TCustomMemoryStream)
  583.   protected
  584.     function Realloc(var NewCapacity: Longint): Pointer; virtual;
  585.     property Capacity: Longint;
  586.   public
  587.     destructor Destroy; override;
  588.     procedure Clear;
  589.     procedure LoadFromStream(Stream: TStream);
  590.     procedure LoadFromFile(const FileName: string);
  591.     procedure SetSize(NewSize: Longint); override;
  592.     function Write(const Buffer; Count: Longint): Longint; override;
  593.   end;
  594.  
  595. { TStringStream }
  596.  
  597.   TStringStream = class(TStream)
  598.   protected
  599.     procedure SetSize(NewSize: Longint); override;
  600.   public
  601.     constructor Create(const AString: string);
  602.     function Read(var Buffer; Count: Longint): Longint; override;
  603.     function ReadString(Count: Longint): string;
  604.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  605.     function Write(const Buffer; Count: Longint): Longint; override;
  606.     procedure WriteString(const AString: string);
  607.     property DataString: string;
  608.   end;
  609.  
  610. { TResourceStream }
  611.  
  612.   TResourceStream = class(TCustomMemoryStream)
  613.   public
  614.     constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
  615.     constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
  616.     destructor Destroy; override;
  617.     function Write(const Buffer; Count: Longint): Longint; override;
  618.   end;
  619.  
  620. { TStreamAdapter }
  621. { Implements OLE IStream on VCL TStream }
  622.  
  623.   TStreamOwnership = (soReference, soOwned);
  624.  
  625.   TStreamAdapter = class(TInterfacedObject, IStream)
  626.   public
  627.     constructor Create(Stream: TStream; Ownership: TStreamOwnership = soReference);
  628.     destructor Destroy; override;
  629.     function Read(pv: Pointer; cb: Longint;
  630.       pcbRead: PLongint): HResult; virtual; stdcall;
  631.     function Write(pv: Pointer; cb: Longint;
  632.       pcbWritten: PLongint): HResult; virtual; stdcall;
  633.     function Seek(dlibMove: Largeint; dwOrigin: Longint;
  634.       out libNewPosition: Largeint): HResult; virtual; stdcall;
  635.     function SetSize(libNewSize: Largeint): HResult; virtual; stdcall;
  636.     function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
  637.       out cbWritten: Largeint): HResult; virtual; stdcall;
  638.     function Commit(grfCommitFlags: Longint): HResult; virtual; stdcall;
  639.     function Revert: HResult; virtual; stdcall;
  640.     function LockRegion(libOffset: Largeint; cb: Largeint;
  641.       dwLockType: Longint): HResult; virtual; stdcall;
  642.     function UnlockRegion(libOffset: Largeint; cb: Largeint;
  643.       dwLockType: Longint): HResult; virtual; stdcall;
  644.     function Stat(out statstg: TStatStg;
  645.       grfStatFlag: Longint): HResult; virtual; stdcall;
  646.     function Clone(out stm: IStream): HResult; virtual; stdcall;
  647.     property Stream: TStream;
  648.     property StreamOwnership: TStreamOwnership;
  649.   end;
  650.  
  651. { TClassFinder }
  652.  
  653.   TGetClass = procedure (AClass: TPersistentClass) of object;
  654.  
  655.   TClassFinder = class
  656.   public
  657.     constructor Create(AClass: TPersistentClass = nil;
  658.       AIncludeActiveGroups: Boolean = False);
  659.     destructor Destroy; override;
  660.     function GetClass(const AClassName: string): TPersistentClass;
  661.     procedure GetClasses(Proc: TGetClass);
  662.   end;
  663.  
  664. { TFiler }
  665.  
  666.   TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
  667.     vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
  668.     vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString,
  669.     vaInt64, vaUTF8String);
  670.  
  671.   TFilerFlag = (ffInherited, ffChildPos, ffInline);
  672.   TFilerFlags = set of TFilerFlag;
  673.  
  674.   TReaderProc = procedure(Reader: TReader) of object;
  675.   TWriterProc = procedure(Writer: TWriter) of object;
  676.   TStreamProc = procedure(Stream: TStream) of object;
  677.  
  678.   IInterfaceComponentReference = interface
  679.     ['{E28B1858-EC86-4559-8FCD-6B4F824151ED}']
  680.     function GetComponent: TComponent;
  681.   end;
  682.  
  683.   TFiler = class(TObject)
  684.   protected
  685.     procedure SetRoot(Value: TComponent); virtual;
  686.   public
  687.     constructor Create(Stream: TStream; BufSize: Integer);
  688.     destructor Destroy; override;
  689.     procedure DefineProperty(const Name: string;
  690.       ReadData: TReaderProc; WriteData: TWriterProc;
  691.       HasData: Boolean); virtual; abstract;
  692.     procedure DefineBinaryProperty(const Name: string;
  693.       ReadData, WriteData: TStreamProc;
  694.       HasData: Boolean); virtual; abstract;
  695.     procedure FlushBuffer; virtual; abstract;
  696.     property Root: TComponent;
  697.     property LookupRoot: TComponent;
  698.     property Ancestor: TPersistent;
  699.     property IgnoreChildren: Boolean;
  700.   end;
  701.  
  702. { TComponent class reference type }
  703.  
  704.   TComponentClass = class of TComponent;
  705.  
  706. { Custom variant stream support }
  707.  
  708.   IVarStreamable = interface
  709.     ['{D60BA026-5E42-4C2A-BB01-3F1C8F30A28E}']
  710.     procedure StreamIn(var Dest: TVarData; const Stream: TStream);
  711.     procedure StreamOut(const Source: TVarData; const Stream: TStream);
  712.   end;
  713.  
  714. { TReader }
  715.  
  716.   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
  717.     var Address: Pointer; var Error: Boolean) of object;
  718.   TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
  719.     var Name: string) of object;
  720.   TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
  721.   TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
  722.     ComponentClass: TPersistentClass; var Component: TComponent) of object;
  723.   TReadComponentsProc = procedure(Component: TComponent) of object;
  724.   TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
  725.   TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string;
  726.     var ComponentClass: TComponentClass) of object;
  727.   TCreateComponentEvent = procedure(Reader: TReader;
  728.     ComponentClass: TComponentClass; var Component: TComponent) of object;
  729.  
  730.   TReader = class(TFiler)
  731.   protected
  732.     function Error(const Message: string): Boolean; virtual;
  733.     function FindAncestorComponent(const Name: string;
  734.       ComponentClass: TPersistentClass): TComponent; virtual;
  735.     function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
  736.     procedure SetName(Component: TComponent; var Name: string); virtual;
  737.     procedure ReadProperty(AInstance: TPersistent);
  738.     procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
  739.     procedure ReferenceName(var Name: string); virtual;
  740.     procedure PropertyError(const Name: string);
  741.     procedure ReadData(Instance: TComponent);
  742.     function ReadSet(SetType: Pointer): Integer;
  743.     procedure SetPosition(Value: Longint);
  744.     procedure SkipBytes(Count: Integer);
  745.     procedure SkipSetBody;
  746.     procedure SkipProperty;
  747.     procedure SkipComponent(SkipHeader: Boolean);
  748.     property PropName: string;
  749.     property CanHandleExceptions: Boolean;
  750.   public
  751.     destructor Destroy; override;
  752.     procedure BeginReferences;
  753.     procedure CheckValue(Value: TValueType);
  754.     procedure DefineProperty(const Name: string;
  755.       ReadData: TReaderProc; WriteData: TWriterProc;
  756.       HasData: Boolean); override;
  757.     procedure DefineBinaryProperty(const Name: string;
  758.       ReadData, WriteData: TStreamProc;
  759.       HasData: Boolean); override;
  760.     function EndOfList: Boolean;
  761.     procedure EndReferences;
  762.     procedure FixupReferences;
  763.     procedure FlushBuffer; override;
  764.     function NextValue: TValueType;
  765.     procedure Read(var Buf; Count: Longint);
  766.     function ReadBoolean: Boolean;
  767.     function ReadChar: Char;
  768.     procedure ReadCollection(Collection: TCollection);
  769.     function ReadComponent(Component: TComponent): TComponent;
  770.     procedure ReadComponents(AOwner, AParent: TComponent;
  771.       Proc: TReadComponentsProc);
  772.     function ReadFloat: Extended;
  773.     function ReadSingle: Single;
  774.     function ReadCurrency: Currency;
  775.     function ReadDate: TDateTime;
  776.     function ReadIdent: string;
  777.     function ReadInteger: Longint;
  778.     function ReadInt64: Int64;
  779.     procedure ReadListBegin;
  780.     procedure ReadListEnd;
  781.     procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer); virtual;
  782.     function ReadRootComponent(Root: TComponent): TComponent;
  783.     procedure ReadSignature;
  784.     function ReadStr: string;
  785.     function ReadString: string;
  786.     function ReadWideString: WideString;
  787.     function ReadValue: TValueType;
  788.     function ReadVariant: Variant;
  789.     procedure CopyValue(Writer: TWriter);
  790.     procedure SkipValue;
  791.     property Owner: TComponent;
  792.     property Parent: TComponent;
  793.     property Position: Longint;
  794.     property OnError: TReaderError;
  795.     property OnFindMethod: TFindMethodEvent;
  796.     property OnSetName: TSetNameEvent;
  797.     property OnReferenceName: TReferenceNameEvent;
  798.     property OnAncestorNotFound: TAncestorNotFoundEvent;
  799.     property OnCreateComponent: TCreateComponentEvent;
  800.     property OnFindComponentClass: TFindComponentClassEvent;
  801.   end;
  802.  
  803. { TWriter }
  804.  
  805.   TFindAncestorEvent = procedure (Writer: TWriter; Component: TComponent;
  806.     const Name: string; var Ancestor, RootAncestor: TComponent) of object;
  807.  
  808.   TWriter = class(TFiler)
  809.   protected
  810.     procedure SetRoot(Value: TComponent); override;
  811.     procedure WriteBinary(WriteData: TStreamProc);
  812.     procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
  813.     procedure WriteProperty(Instance: TPersistent; PropInfo: PPropInfo);
  814.     procedure WriteProperties(Instance: TPersistent);
  815.     procedure WritePropName(const PropName: string);
  816.     procedure WriteValue(Value: TValueType);
  817.   public
  818.     destructor Destroy; override;
  819.     procedure DefineProperty(const Name: string;
  820.       ReadData: TReaderProc; WriteData: TWriterProc;
  821.       HasData: Boolean); override;
  822.     procedure DefineBinaryProperty(const Name: string;
  823.       ReadData, WriteData: TStreamProc;
  824.       HasData: Boolean); override;
  825.     procedure FlushBuffer; override;
  826.     procedure Write(const Buf; Count: Longint);
  827.     procedure WriteBoolean(Value: Boolean);
  828.     procedure WriteCollection(Value: TCollection);
  829.     procedure WriteComponent(Component: TComponent);
  830.     procedure WriteChar(Value: Char);
  831.     procedure WriteDescendent(Root: TComponent; AAncestor: TComponent);
  832.     procedure WriteFloat(const Value: Extended);
  833.     procedure WriteSingle(const Value: Single);
  834.     procedure WriteCurrency(const Value: Currency);
  835.     procedure WriteDate(const Value: TDateTime);
  836.     procedure WriteIdent(const Ident: string);
  837.     procedure WriteInteger(Value: Longint); overload;
  838.     procedure WriteInteger(Value: Int64); overload;
  839.     procedure WriteListBegin;
  840.     procedure WriteListEnd;
  841.     procedure WriteRootComponent(Root: TComponent);
  842.     procedure WriteSignature;
  843.     procedure WriteStr(const Value: string);
  844.     procedure WriteString(const Value: string);
  845.     procedure WriteWideString(const Value: WideString);
  846.     procedure WriteVariant(const Value: Variant);
  847.     property Position: Longint;
  848.     property RootAncestor: TComponent;
  849.     property OnFindAncestor: TFindAncestorEvent;
  850.     property UseQualifiedNames: Boolean;
  851.   end;
  852.  
  853. { TParser }
  854.  
  855.   TParser = class(TObject)
  856.   public
  857.     constructor Create(Stream: TStream);
  858.     destructor Destroy; override;
  859.     procedure CheckToken(T: Char);
  860.     procedure CheckTokenSymbol(const S: string);
  861.     procedure Error(const Ident: string);
  862.     procedure ErrorFmt(const Ident: string; const Args: array of const);
  863.     procedure ErrorStr(const Message: string);
  864.     procedure HexToBinary(Stream: TStream);
  865.     function NextToken: Char;
  866.     function SourcePos: Longint;
  867.     function TokenComponentIdent: string;
  868.     function TokenFloat: Extended;
  869.     function TokenInt: Int64;
  870.     function TokenString: string;
  871.     function TokenWideString: WideString;
  872.     function TokenSymbolIs(const S: string): Boolean;
  873.     property FloatType: Char;
  874.     property SourceLine: Integer;
  875.     property Token: Char;
  876.   end;
  877.  
  878. { TThread }
  879.  
  880.   EThread = class(Exception);
  881.  
  882.   TThreadMethod = procedure of object;
  883.  
  884. {$IFDEF MSWINDOWS}
  885.   TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
  886.     tpTimeCritical);
  887. {$ENDIF}
  888.  
  889.   TThread = class
  890.   protected
  891.     procedure DoTerminate; virtual;
  892.     procedure Execute; virtual; abstract;
  893.     procedure Synchronize(Method: TThreadMethod);
  894.     property ReturnValue: Integer;
  895.     property Terminated: Boolean;
  896.   public
  897.     constructor Create(CreateSuspended: Boolean);
  898.     destructor Destroy; override;
  899.     procedure AfterConstruction; override;
  900.     procedure Resume;
  901.     procedure Suspend;
  902.     procedure Terminate;
  903.     function WaitFor: LongWord;
  904.     property FatalException: TObject;
  905.     property FreeOnTerminate: Boolean;
  906.     property Handle: THandle;
  907. {$IFDEF MSWINDOWS}
  908.     property Priority: TT;
  909. {$ENDIF}
  910. {$IFDEF LINUX}
  911.     // ** Priority is an Integer **
  912.     property Priority: Integer;
  913.     property Policy: Integer;
  914. {$ENDIF}
  915.     property Suspended: Boolean;
  916. {$IFDEF MSWINDOWS}
  917.     property T;
  918. {$ENDIF}
  919. {$IFDEF LINUX}
  920.     // ** ThreadId is Cardinal **
  921.     property T;
  922. {$ENDIF}
  923.     property OnTerminate: TNotifyEvent;
  924.   end;
  925.  
  926. { TComponent class }
  927.  
  928.   TOperation = (opInsert, opRemove);
  929.   TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
  930.     csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification,
  931.     csInline, csDesignInstance);
  932.   TComponentStyle = set of (csInheritable, csCheckPropAvail, csSubComponent,
  933.     csTransient);
  934.   TGetChildProc = procedure (Child: TComponent) of object;
  935.  
  936.   TComponentName = type string;
  937.  
  938.  
  939.   IVCLComObject = interface
  940.     ['{E07892A0-F52F-11CF-BD2F-0020AF0E5B81}']
  941.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  942.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  943.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  944.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  945.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  946.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  947.     function SafeCallException(ExceptObject: TObject;
  948.       ExceptAddr: Pointer): HResult;
  949.     procedure FreeOnRelease;
  950.   end;
  951.  
  952.  
  953.   IDesignerNotify = interface
  954.     ['{B971E807-E3A6-11D1-AAB1-00C04FB16FBC}']
  955.     procedure Modified;
  956.     procedure Notification(AnObject: TPersistent; Operation: TOperation);
  957.   end;
  958.  
  959.   TBasicAction = class;
  960.  
  961.   TComponent = class(TPersistent, IInterface, IInterfaceComponentReference)
  962.   protected
  963.     FComponentStyle: TComponentStyle;
  964.     procedure ChangeName(const NewName: TComponentName);
  965.     procedure DefineProperties(Filer: TFiler); override;
  966.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
  967.     function GetChildOwner: TComponent; dynamic;
  968.     function GetChildParent: TComponent; dynamic;
  969.     function GetOwner: TPersistent; override;
  970.     procedure Loaded; virtual;
  971.     procedure Notification(AComponent: TComponent;
  972.       Operation: TOperation); virtual;
  973.     procedure PaletteCreated; dynamic;
  974.     procedure ReadState(Reader: TReader); virtual;
  975.     procedure SetAncestor(Value: Boolean);
  976.     procedure SetDesigning(Value: Boolean; SetChildren: Boolean = True);
  977.     procedure SetInline(Value: Boolean);
  978.     procedure SetDesignInstance(Value: Boolean);
  979.     procedure SetName(const NewName: TComponentName); virtual;
  980.     procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
  981.     procedure SetParentComponent(Value: TComponent); dynamic;
  982.     procedure Updating; dynamic;
  983.     procedure Updated; dynamic;
  984.     class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); virtual;
  985.     procedure ValidateRename(AComponent: TComponent;
  986.       const CurName, NewName: string); virtual;
  987.     procedure ValidateContainer(AComponent: TComponent); dynamic;
  988.     procedure ValidateInsert(AComponent: TComponent); dynamic;
  989.     procedure WriteState(Writer: TWriter); virtual;
  990.     { IInterface }
  991.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  992.     function _AddRef: Integer; stdcall;
  993.     function _Release: Integer; stdcall;
  994.  
  995.     { IDispatch }
  996.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  997.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  998.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  999.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  1000.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  1001.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  1002.  
  1003.   public
  1004.     constructor Create(AOwner: TComponent); virtual;
  1005.     destructor Destroy; override;
  1006.     procedure BeforeDestruction; override;
  1007.     procedure DestroyComponents;
  1008.     procedure Destroying;
  1009.     function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
  1010.     function FindComponent(const AName: string): TComponent;
  1011.     procedure FreeNotification(AComponent: TComponent);
  1012.     procedure RemoveFreeNotification(AComponent: TComponent);
  1013.  
  1014.     procedure FreeOnRelease;
  1015.  
  1016.     function GetParentComponent: TComponent; dynamic;
  1017.     function GetNamePath: string; override;
  1018.     function HasParent: Boolean; dynamic;
  1019.     procedure InsertComponent(AComponent: TComponent);
  1020.     procedure RemoveComponent(AComponent: TComponent);
  1021.     procedure SetSubComponent(IsSubComponent: Boolean);
  1022.     function SafeCallException(ExceptObject: TObject;
  1023.       ExceptAddr: Pointer): HResult; override;
  1024.     function UpdateAction(Action: TBasicAction): Boolean; dynamic;
  1025.     function IsImplementorOf(const I: IInterface): Boolean;
  1026.     function ReferenceInterface(const I: IInterface; Operation: TOperation): Boolean;
  1027.  
  1028.     property ComObject: IUnknown;
  1029.  
  1030.     property Components[Index: Integer]: TComponent;
  1031.     property ComponentCount: Integer;
  1032.     property ComponentIndex: Integer;
  1033.     property ComponentState: TComponentState;
  1034.     property ComponentStyle: TComponentStyle;
  1035.     property DesignInfo: Longint;
  1036.     property Owner: TComponent;
  1037.  
  1038.     property VCLComObject: Pointer;
  1039.  
  1040.   published
  1041.     property Name: TComponentName;
  1042.     property Tag: Longint default 0;
  1043.   end;
  1044.  
  1045. { TBasicActionLink }
  1046.  
  1047.   TBasicActionLink = class(TObject)
  1048.   protected
  1049.     FAction: TBasicAction;
  1050.     procedure AssignClient(AClient: TObject); virtual;
  1051.     procedure Change; virtual;
  1052.     function IsOnExecuteLinked: Boolean; virtual;
  1053.     procedure SetAction(Value: TBasicAction); virtual;
  1054.     procedure SetOnExecute(Value: TNotifyEvent); virtual;
  1055.   public
  1056.     constructor Create(AClient: TObject); virtual;
  1057.     destructor Destroy; override;
  1058.     function Execute(AComponent: TComponent = nil): Boolean; virtual;
  1059.     function Update: Boolean; virtual;
  1060.     property Action: TBasicAction;
  1061.     property OnChange: TNotifyEvent;
  1062.   end;
  1063.  
  1064.   TBasicActionLinkClass = class of TBasicActionLink;
  1065.  
  1066. { TBasicAction }
  1067.  
  1068.   TBasicAction = class(TComponent)
  1069.   protected
  1070.     FClients: TList;
  1071.     procedure Change; virtual;
  1072.     procedure SetOnExecute(Value: TNotifyEvent); virtual;
  1073.     property OnChange: TNotifyEvent;
  1074.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1075.   public
  1076.     constructor Create(AOwner: TComponent); override;
  1077.     destructor Destroy; override;
  1078.     function HandlesTarget(Target: TObject): Boolean; virtual;
  1079.     procedure UpdateTarget(Target: TObject); virtual;
  1080.     procedure ExecuteTarget(Target: TObject); virtual;
  1081.     function Execute: Boolean; dynamic;
  1082.     procedure RegisterChanges(Value: TBasicActionLink);
  1083.     procedure UnRegisterChanges(Value: TBasicActionLink);
  1084.     function Update: Boolean; virtual;
  1085.     property ActionComponent: TComponent;
  1086.     property OnExecute: TNotifyEvent;
  1087.     property OnUpdate: TNotifyEvent;
  1088.   end;
  1089.  
  1090. { TBasicAction class reference type }
  1091.  
  1092.   TBasicActionClass = class of TBasicAction;
  1093.  
  1094. { TDataModule }
  1095.  
  1096.   TDataModule = class(TComponent)
  1097.   protected
  1098.     procedure DoCreate; virtual;
  1099.     procedure DoDestroy; virtual;
  1100.     procedure DefineProperties(Filer: TFiler); override;
  1101.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1102.     function HandleCreateException: Boolean; dynamic;
  1103.     procedure ReadState(Reader: TReader); override;
  1104.   public
  1105.     constructor Create(AOwner: TComponent); override;
  1106.     constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); virtual;
  1107.     destructor Destroy; override;
  1108.     procedure AfterConstruction; override;
  1109.     procedure BeforeDestruction; override;
  1110.     property DesignOffset: TPoint;
  1111.     property DesignSize: TPoint;
  1112.   published
  1113.     property OldCreateOrder: Boolean;
  1114.     property OnCreate: TNotifyEvent;
  1115.     property OnDestroy: TNotifyEvent;
  1116.   end;
  1117.  
  1118. var
  1119.   AddDataModule: procedure (DataModule: TDataModule) of object = nil;
  1120.   RemoveDataModule: procedure (DataModule: TDataModule) of object = nil;
  1121.   ApplicationHandleException: procedure (Sender: TObject) of object = nil;
  1122.   ApplicationShowException: procedure (E: Exception) of object = nil;
  1123.  
  1124. { Component registration handlers }
  1125.  
  1126.   RegisterComponentsProc: procedure(const Page: string;
  1127.     ComponentClasses: array of TComponentClass) = nil;
  1128.   RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = nil;
  1129.   CurrentGroup: Integer = -1; { Current design group }
  1130.  
  1131. {$IFDEF MSWINDOWS}
  1132. type
  1133.   TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
  1134.  
  1135. var
  1136.   RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
  1137.     AxRegType: TActiveXRegType) = nil;
  1138. {$ENDIF}
  1139.  
  1140.   CreateVCLComObjectProc: procedure(Component: TComponent) = nil;
  1141.  
  1142.  
  1143.  
  1144. { Point and rectangle constructors }
  1145.  
  1146. function Point(AX, AY: Integer): TPoint;
  1147. function SmallPoint(AX, AY: SmallInt): TSmallPoint;
  1148. function PointsEqual(const P1, P2: TPoint): Boolean; overload;
  1149. function PointsEqual(const P1, P2: TSmallPoint): Boolean; overload;
  1150. function InvalidPoint(X, Y: Integer): Boolean; overload;
  1151. function InvalidPoint(const At: TPoint): Boolean; overload;
  1152. function InvalidPoint(const At: TSmallPoint): Boolean; overload;
  1153.  
  1154. function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect; overload;
  1155. function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload;
  1156. function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  1157.  
  1158. { Class registration routines }
  1159.  
  1160. procedure RegisterClass(AClass: TPersistentClass);
  1161. procedure RegisterClasses(AClasses: array of TPersistentClass);
  1162. procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
  1163. procedure UnRegisterClass(AClass: TPersistentClass);
  1164. procedure UnRegisterClasses(AClasses: array of TPersistentClass);
  1165. procedure UnRegisterModuleClasses(Module: HMODULE);
  1166. function FindClass(const ClassName: string): TPersistentClass;
  1167. function GetClass(const AClassName: string): TPersistentClass;
  1168. procedure StartClassGroup(AClass: TPersistentClass);
  1169. procedure GroupDescendentsWith(AClass, AClassGroup: TPersistentClass);
  1170. function ActivateClassGroup(AClass: TPersistentClass): TPersistentClass;
  1171. function ClassGroupOf(AClass: TPersistentClass): TPersistentClass; overload;
  1172. function ClassGroupOf(Instance: TPersistent): TPersistentClass; overload;
  1173.  
  1174. { Component registration routines }
  1175.  
  1176. procedure RegisterComponents(const Page: string;
  1177.   ComponentClasses: array of TComponentClass);
  1178. procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
  1179. {$IFDEF MSWINDOWS}
  1180. procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
  1181.   AxRegType: TActiveXRegType);
  1182. {$ENDIF}
  1183.  
  1184. var
  1185.   GlobalNameSpace: TMultiReadExclusiveWriteSynchronizer;
  1186.  
  1187. { Object filing routines }
  1188.  
  1189. type
  1190.   TIdentMapEntry = record
  1191.     Value: Integer;
  1192.     Name: String;
  1193.   end;
  1194.  
  1195.   TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
  1196.   TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
  1197.   TFindGlobalComponent = function(const Name: string): TComponent;
  1198.   TIsUniqueGlobalComponentName = function(const Name: string): Boolean;
  1199.  
  1200. var
  1201.   IsUniqueGlobalComponentNameProc: TIsUniqueGlobalComponentName;
  1202.  
  1203. procedure RegisterIntegerConsts(AIntegerType: Pointer; AIdentToInt: TIdentToInt;
  1204.   AIntToIdent: TIntToIdent);
  1205. procedure UnregisterIntegerConsts(AIntegerType: Pointer; AIdentToInt: TIdentToInt;
  1206.   AIntToIdent: TIntToIdent);
  1207. procedure RegisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
  1208. procedure UnregisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
  1209. function FindGlobalComponent(const Name: string): TComponent;
  1210. function IsUniqueGlobalComponentName(const Name: string): Boolean;
  1211. function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
  1212. function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
  1213. function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
  1214. function FindIdentToInt(AIntegerType: Pointer): TIdentToInt;
  1215.  
  1216. function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
  1217. function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
  1218. function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
  1219. function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
  1220. function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
  1221. procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
  1222.  
  1223. procedure GlobalFixupReferences;
  1224. procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
  1225. procedure GetFixupInstanceNames(Root: TComponent;
  1226.   const ReferenceRootName: string; Names: TStrings);
  1227. procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
  1228.   NewRootName: string);
  1229. procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
  1230. procedure RemoveFixups(Instance: TPersistent);
  1231. function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
  1232.  
  1233. procedure BeginGlobalLoading;
  1234. procedure NotifyGlobalLoading;
  1235. procedure EndGlobalLoading;
  1236.  
  1237. function CollectionsEqual(C1, C2: TCollection; Owner1, Owner2: TComponent): Boolean;
  1238.  
  1239. { find the ultimate owner of a collection or item (or persistent for that matter) }
  1240. function GetUltimateOwner(ACollectionItem: TCollectionItem): TPersistent; overload;
  1241. function GetUltimateOwner(ACollection: TCollection): TPersistent; overload;
  1242. function GetUltimateOwner(APersistent: TPersistent): TPersistent; overload;
  1243.  
  1244. { Object conversion routines }
  1245.  
  1246. type
  1247.   TStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
  1248.  
  1249. procedure ObjectBinaryToText(Input, Output: TStream); overload;
  1250. procedure ObjectBinaryToText(Input, Output: TStream;
  1251.   var OriginalFormat: TStreamOriginalFormat); overload;
  1252. procedure ObjectTextToBinary(Input, Output: TStream); overload;
  1253. procedure ObjectTextToBinary(Input, Output: TStream;
  1254.   var OriginalFormat: TStreamOriginalFormat); overload;
  1255.  
  1256. procedure ObjectResourceToText(Input, Output: TStream); overload;
  1257. procedure ObjectResourceToText(Input, Output: TStream;
  1258.   var OriginalFormat: TStreamOriginalFormat); overload;
  1259. procedure ObjectTextToResource(Input, Output: TStream); overload;
  1260. procedure ObjectTextToResource(Input, Output: TStream;
  1261.   var OriginalFormat: TStreamOriginalFormat); overload;
  1262.  
  1263. function TestStreamFormat(Stream: TStream): TStreamOriginalFormat;
  1264.  
  1265. { Utility routines }
  1266.  
  1267. function LineStart(Buffer, BufPos: PChar): PChar;
  1268. function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar;
  1269.   Strings: TStrings): Integer;
  1270.  
  1271. procedure BinToHex(Buffer, Text: PChar; BufSize: Integer);
  1272. function HexToBin(Text, Buffer: PChar; BufSize: Integer): Integer;
  1273.  
  1274. function FindRootDesigner(Obj: TPersistent): IDesignerNotify;
  1275.  
  1276. { CountGenerations:  Use this helper function to calculate the distance
  1277.   between two related classes.  Returns -1 if Descendent is not a descendent of
  1278.   Ancestor. }
  1279.  
  1280. function CountGenerations(Ancestor, Descendent: TClass): Integer;
  1281.  
  1282. {  Call CheckSynchronize periodically within the main thread in order for
  1283.    background threads to synchronize execution with the main thread.  This
  1284.    is mainly for applications that have an event driven UI such as Windows
  1285.    or XWindows (Qt/CLX).  The best place this can be called is during Idle
  1286.    processing.  This guarantees that the main thread is in a known "good"
  1287.    state so that method calls can be safely made.  Returns True if a method
  1288.    was synchronized.  Returns False if there was nothing done.
  1289. }
  1290. function CheckSynchronize: Boolean;
  1291.  
  1292. { Assign a method to WakeMainThread in order to properly force an event into
  1293.   the GUI thread's queue.  This will make sure that non-GUI threads can quickly
  1294.   synchronize with the GUI thread even if no events are being processed due to
  1295.   an idle state }
  1296. var
  1297.   WakeMainThread: TNotifyEvent = nil;
  1298.  
  1299. {$IFDEF MSWINDOWS}
  1300.  
  1301. type
  1302.   TWndMethod = procedure(var Message: TMessage) of object;
  1303.  
  1304. function MakeObjectInstance(Method: TWndMethod): Pointer;
  1305. procedure FreeObjectInstance(ObjectInstance: Pointer);
  1306.  
  1307. function AllocateHWnd(Method: TWndMethod): HWND;
  1308. procedure DeallocateHWnd(Wnd: HWND);
  1309.  
  1310. {$ENDIF}
  1311.  
  1312. implementation
  1313.